22BT

Technical details

Show code
library(GeoPressureR)
library(leaflet)
library(leaflet.extras)
library(raster)
library(dplyr)
library(ggplot2)
library(kableExtra)
library(plotly)
library(GeoLocTools)
setupGeolocation()
knitr::opts_chunk$set(echo = FALSE)
load(paste0("../data/1_pressure/", params$gdl_id, "_pressure_prob.Rdata"))
load(paste0("../data/2_light/", params$gdl_id, "_light_prob.Rdata"))
load(paste0("../data/3_static/", params$gdl_id, "_static_prob.Rdata"))
load(paste0("../data/4_basic_graph/", params$gdl_id, "_basic_graph.Rdata"))

Settings used

All the results produced here are generated with (1) the raw geolocator data, (2) the labeled files of pressure and light and (3) the parameters listed below.

Show code
kable(gpr) %>% scroll_box(width = "100%")
include gdl_id crop_start crop_end thr_dur extent_N extent_W extent_S extent_E map_scale map_max_sample map_margin prob_map_s prob_map_thr shift_k calib_lon calib_lat calib_1_start calib_1_end calib_2_start calib_2_end calib_2_lon calib_2_lat prob_light_w thr_prob_percentile thr_gs RingNo scientific_name common_name mass wing_span Color
TRUE 22BT 1900-01-01 2100-01-01 12 50 20 -35 120 2 300 30 1 0.9 21600 110.83 48.57 2018-07-15 2018-08-26 NA NA NA NA 0.1 0.9 120 NA NA Eurasian Nightjar NA NA NA

Pressure timeserie

The labeling of pressure data is illustrated with this figure. The black dots indicates the pressure datapoint not considered in the matching. Each stationay period is illustrated by a different colored line.

Show code
pressure_na <- pam$pressure %>%
  mutate(obs = ifelse(isoutliar | sta_id == 0, NA, obs))
p <- ggplot() +
  geom_line(data = pam$pressure, aes(x = date, y = obs), colour = "grey") +
  geom_point(data = subset(pam$pressure, isoutliar), aes(x = date, y = obs), colour = "black") +
  # geom_line(data = pressure_na, aes(x = date, y = obs, color = factor(sta_id)), size = 0.5) +
  geom_line(data = do.call("rbind", shortest_path_timeserie) %>% filter(sta_id>0), aes(x = date, y = pressure0, col = factor(sta_id))) +
  theme_bw() +
  scale_colour_manual(values = col) +
  scale_y_continuous(name = "Pressure(hPa)")

ggplotly(p, dynamicTicks = T) %>% layout(showlegend = F)

Light

See geolocator manual for more information on this figure

Show code
raw_geolight <- pam$light %>%
  transmute(
    Date = date,
    Light = obs
  )
lightImage(tagdata = raw_geolight, offset = gpr$shift_k/60/60)
tsimagePoints(twl$twilight,
  offset = gpr$shift_k/60/60, pch = 16, cex = 1.2,
  col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
)
abline(v = gpr$calib_2_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_start, lty = 1, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_2_end, lty = 2, col = "firebrick", lwd = 1.5)
abline(v = gpr$calib_1_end, lty = 2, col = "firebrick", lwd = 1.5)

The histogram of zenith angle at the calibration site together with the fitted kernel density. Note that we use a large bandwidth of the kernel to account of the bias of the calibration site.

Show code
hist(z, freq = F)
lines(fit_z, col = "red")

The probability map resulting from light data alone can be seen below.

Show code
li_s <- list()
l <- leaflet(width = "100%") %>%
  addProviderTiles(providers$Stamen.TerrainBackground) %>%
  addFullscreenControl()
for (i_r in seq_len(length(light_prob))) {
  i_s <- metadata(light_prob[[i_r]])$sta_id
  info <- pam$sta[pam$sta$sta_id == i_s, ]
  info_str <- paste0(i_s, " | ", info$start, "->", info$end)
  li_s <- append(li_s, info_str)
  l <- l %>% addRasterImage(light_prob[[i_r]], opacity = 0.8, colors = "OrRd", group = info_str)
}
l %>%
  addCircles(lng = gpr$calib_lon, lat = gpr$calib_lat, color = "black", opacity = 1) %>%
  addLayersControl(
    overlayGroups = li_s,
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(tail(li_s, length(li_s) - 1))

Light vs Pressure

We can compare light and pressure location at long stationary stopover (>5 days). By assuming the best match of the pressure to be the truth, we can plot the histogram of the zenith angle and compare to the fit of kernel density at the calibration site.

Show code
 raw_geolight <- pam$light %>%
    transmute(
      Date = date,
      Light = obs
    )
 dur <- unlist(lapply(pressure_prob, function(x) difftime(metadata(x)$temporal_extent[2],metadata(x)$temporal_extent[1], units = "days" )))
  long_id <- which(dur>5)

  par(mfrow = c(2, 3))
  for (i_s in long_id){
    twl_fl <- twl %>%
      filter(!deleted) %>%
      filter(twilight>shortest_path_timeserie[[i_s]]$date[1] & twilight<tail(shortest_path_timeserie[[i_s]]$date,1))
    sun <-  solar(twl_fl$twilight)
    z_i <- refracted(zenith(sun, shortest_path_timeserie[[i_s]]$lon[1], shortest_path_timeserie[[i_s]]$lat[1]))
    hist(z_i, freq = F, main = paste0("sta_id=",i_s, " | ",nrow(twl_fl),"twls"))
    lines(fit_z, col = "red")
    xlab("Zenith angle")
  }

Similarly, we can plot the line of sunrise/sunset at the best match of pressure (yellow line) and compare to the raw and labeled light data.

Show code
  lightImage(
    tagdata = raw_geolight,
    offset = gpr$shift_k / 60 / 60
  )
  tsimagePoints(twl$twilight,
                offset = gpr$shift_k / 60 / 60, pch = 16, cex = 1.2,
                col = ifelse(twl$deleted, "grey20", ifelse(twl$rise, "firebrick", "cornflowerblue"))
  )
  for (ts in shortest_path_timeserie){
    twl_fl <- twl %>%
      filter(twilight>ts$date[1] & twilight<tail(ts$date,1))
    tsimageDeploymentLines(twl_fl$twilight,
                           lon = ts$lon[1], ts$lat[1],
                           offset = gpr$shift_k / 60 / 60, lwd = 3,col = adjustcolor("orange", alpha.f = 0.5))
  }

GeoPressureViz

To visualize the path on GeoPressureViz, you will need to also load the pressure and light probability map and align them first with the code below.

Show code
sta_marginal <- unlist(lapply(static_prob_marginal, function(x) raster::metadata(x)$sta_id))
sta_pres <- unlist(lapply(pressure_prob, function(x) raster::metadata(x)$sta_id))
sta_light <- unlist(lapply(light_prob, function(x) raster::metadata(x)$sta_id))
pressure_prob <- pressure_prob[sta_pres %in% sta_marginal]
light_prob <- light_prob[sta_light %in% sta_marginal]

The code below will open with the shortest path computed with the graph approach. You can change it to

Show code
geopressureviz <- list(
  pam_data = pam,
  static_prob = static_prob,
  static_prob_marginal = static_prob_marginal,
  pressure_prob = pressure_prob,
  light_prob = light_prob,
  pressure_timeserie = shortest_path_timeserie
)
save(geopressureviz, file = "~/geopressureviz.RData")

shiny::runApp(system.file("geopressureviz", package = "GeoPressureR"),
  launch.browser = getOption("browser")
)

Stationay period information

Show code
pam$sta %>% kable()
start end sta_id
2018-07-15 00:00:00 2018-08-26 12:35:00 1
2018-08-26 19:45:00 2018-08-27 12:40:00 2
2018-08-27 20:35:00 2018-08-28 13:10:00 3
2018-08-28 15:45:00 2018-08-29 13:55:00 4
2018-08-29 14:50:00 2018-08-29 20:30:00 5
2018-08-29 21:20:00 2018-08-30 12:40:00 6
2018-08-30 22:25:00 2018-08-31 12:55:00 7
2018-08-31 21:50:00 2018-09-01 13:45:00 8
2018-09-01 17:35:00 2018-09-02 14:15:00 9
2018-09-02 19:40:00 2018-09-04 14:10:00 10
2018-09-04 23:15:00 2018-09-05 14:20:00 11
2018-09-05 23:15:00 2018-09-06 15:30:00 12
2018-09-06 22:25:00 2018-09-07 15:00:00 13
2018-09-07 23:55:00 2018-09-08 19:40:00 14
2018-09-09 00:20:00 2018-09-09 15:20:00 15
2018-09-09 22:50:00 2018-09-10 15:30:00 16
2018-09-11 00:30:00 2018-09-11 14:10:00 17
2018-09-12 00:40:00 2018-09-12 19:40:00 18
2018-09-12 20:45:00 2018-09-13 14:00:00 19
2018-09-13 14:55:00 2018-09-14 15:00:00 20
2018-09-14 16:40:00 2018-09-15 13:55:00 21
2018-09-15 15:05:00 2018-09-17 00:30:00 22
2018-09-17 00:40:00 2018-09-17 13:55:00 23
2018-09-17 15:25:00 2018-09-17 16:30:00 24
2018-09-17 19:35:00 2018-09-17 22:35:00 25
2018-09-18 00:00:00 2018-09-19 00:35:00 26
2018-09-19 00:50:00 2018-09-19 13:50:00 27
2018-09-19 14:05:00 2018-09-21 00:20:00 28
2018-09-21 00:55:00 2018-10-01 13:35:00 29
2018-10-01 20:15:00 2018-10-02 14:15:00 30
2018-10-03 01:05:00 2018-10-03 14:00:00 31
2018-10-04 01:20:00 2018-10-04 15:20:00 32
2018-10-04 22:50:00 2018-10-05 14:25:00 33
2018-10-06 01:40:00 2018-10-06 14:55:00 34
2018-10-07 01:50:00 2018-10-07 15:10:00 35
2018-10-08 01:55:00 2018-10-08 15:45:00 36
2018-10-08 21:55:00 2018-10-09 15:10:00 37
2018-10-10 00:20:00 2018-10-10 16:10:00 38
2018-10-10 23:55:00 2018-10-11 14:55:00 39
2018-10-11 15:05:00 2018-10-12 01:45:00 40
2018-10-12 02:10:00 2018-10-12 14:55:00 41
2018-10-12 15:15:00 2018-10-17 21:55:00 42
2018-10-17 23:40:00 2018-10-26 00:40:00 43
2018-10-26 02:05:00 2018-10-26 14:50:00 44
2018-10-26 19:30:00 2018-10-27 14:55:00 45
2018-10-27 20:05:00 2018-10-28 18:35:00 46
2018-10-29 02:20:00 2018-10-29 15:10:00 47
2018-10-29 15:30:00 2018-10-30 18:50:00 48
2018-10-30 22:40:00 2018-10-31 21:45:00 49
2018-10-31 22:25:00 2018-11-01 21:05:00 50
2018-11-01 21:25:00 2018-11-16 15:25:00 51
2018-11-16 19:20:00 2018-11-19 17:05:00 52
2018-11-19 18:55:00 2018-11-21 16:00:00 53
2018-11-21 23:25:00 2018-11-22 15:35:00 54
2018-11-23 02:45:00 2018-11-23 20:50:00 55
2018-11-24 02:45:00 2018-11-24 16:45:00 56
2018-11-25 02:45:00 2018-11-27 17:05:00 57
2018-11-28 02:45:00 2018-11-28 17:25:00 58
2018-11-28 22:10:00 2018-11-29 18:25:00 59
2018-11-29 19:00:00 2018-11-30 02:20:00 60
2018-11-30 02:35:00 2018-11-30 16:30:00 61
2018-12-01 02:10:00 2018-12-01 21:50:00 62
2018-12-02 02:00:00 2018-12-02 18:35:00 63
2018-12-03 02:20:00 2018-12-03 18:45:00 64
2018-12-04 03:10:00 2018-12-04 19:10:00 65
2018-12-05 02:30:00 2018-12-05 19:55:00 66
2018-12-05 20:25:00 2019-04-01 16:50:00 67
2019-04-02 03:30:00 2019-04-02 16:50:00 68
2019-04-03 00:35:00 2019-04-03 16:45:00 69
2019-04-04 03:10:00 2019-04-04 17:05:00 70
2019-04-05 00:20:00 2019-04-05 17:35:00 71
2019-04-05 23:30:00 2019-04-06 18:55:00 72
2019-04-07 03:15:00 2019-04-07 17:10:00 73
2019-04-08 00:15:00 2019-04-08 16:55:00 74
2019-04-09 02:50:00 2019-04-09 17:10:00 75
2019-04-09 19:40:00 2019-04-09 23:55:00 76
2019-04-10 02:55:00 2019-04-10 17:55:00 77
2019-04-10 18:50:00 2019-04-10 20:50:00 78
2019-04-10 21:45:00 2019-04-11 00:55:00 79
2019-04-11 02:40:00 2019-04-11 20:35:00 80
2019-04-12 02:45:00 2019-04-17 16:35:00 81
2019-04-18 02:50:00 2019-04-18 16:30:00 82
2019-04-19 01:30:00 2019-04-19 20:25:00 83
2019-04-19 22:40:00 2019-04-22 17:05:00 84
2019-04-23 04:10:00 2019-04-24 00:35:00 85
2019-04-24 02:55:00 2019-04-29 00:50:00 86
2019-04-29 01:20:00 2019-04-29 16:35:00 87
2019-04-29 20:35:00 2019-04-30 00:10:00 88
2019-04-30 02:25:00 2019-04-30 15:35:00 89
2019-05-01 02:20:00 2019-05-01 16:05:00 90
2019-05-02 02:05:00 2019-05-02 15:30:00 91
2019-05-03 02:00:00 2019-05-03 15:30:00 92
2019-05-04 02:00:00 2019-05-04 15:20:00 93
2019-05-05 01:55:00 2019-05-05 15:25:00 94
2019-05-06 01:45:00 2019-05-06 15:40:00 95
2019-05-07 01:35:00 2019-05-07 15:10:00 96
2019-05-08 01:15:00 2019-05-08 15:50:00 97
2019-05-09 01:00:00 2019-05-09 16:00:00 98
2019-05-09 23:30:00 2019-05-10 16:00:00 99
2019-05-11 00:45:00 2019-05-11 15:05:00 100
2019-05-11 15:10:00 2019-05-12 20:25:00 101
2019-05-12 20:50:00 2019-05-13 18:25:00 102
2019-05-13 19:30:00 2019-05-14 20:50:00 103
2019-05-15 00:35:00 2019-05-15 15:45:00 104
2019-05-16 00:10:00 2019-05-16 14:55:00 105
2019-05-16 15:35:00 2019-05-17 15:05:00 106
2019-05-17 16:10:00 2019-05-18 15:05:00 107
2019-05-18 15:40:00 2019-05-19 15:10:00 108
2019-05-19 15:35:00 2019-05-20 16:00:00 109
2019-05-20 18:05:00 2019-05-21 15:10:00 110
2019-05-21 15:30:00 2019-05-22 15:45:00 111
2019-05-23 00:10:00 2019-05-23 15:00:00 112
2019-05-23 23:50:00 2019-05-24 15:40:00 113
2019-05-24 23:30:00 2019-05-25 15:10:00 114
2019-05-25 23:10:00 2019-05-26 15:55:00 115
2019-05-26 23:00:00 2019-05-27 16:05:00 116
2019-05-27 22:45:00 2019-05-28 14:55:00 117
2019-05-28 15:35:00 2019-05-29 16:20:00 118
2019-05-29 22:40:00 2019-05-30 15:30:00 119
2019-05-30 22:05:00 2019-05-31 06:10:00 120